home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
music
/
cdplay.zip
/
CDPLAYER.FRM
< prev
next >
Wrap
Text File
|
1994-04-01
|
19KB
|
597 lines
VERSION 2.00
Begin Form CDForm
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "CD Player"
ClientHeight = 2400
ClientLeft = 2745
ClientTop = 2070
ClientWidth = 7185
FontBold = -1 'True
FontItalic = -1 'True
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00FFFFFF&
Height = 3090
Icon = CDPLAYER.FRX:0000
Left = 2685
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 2400
ScaleWidth = 7185
Top = 1440
Width = 7305
Begin SSPanel TrackPanel3D
Alignment = 2 'Left Justify - BOTTOM
BackColor = &H00C0C0C0&
Font3D = 0 'None
Height = 1440
Left = 60
TabIndex = 15
Top = 45
Width = 7095
Begin SSPanel frmDisabledCD
Alignment = 8 'Center - BOTTOM
BackColor = &H00C0C0C0&
BevelOuter = 0 'None
Caption = "Please Wait. . ."
Font3D = 0 'None
Height = 1320
Left = 120
TabIndex = 2
Top = 45
Width = 6855
Begin PictureBox picLogo
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 615
Left = 2205
ScaleHeight = 615
ScaleWidth = 2535
TabIndex = 3
Top = 120
Width = 2535
Begin Label lblLogo
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "CD Player"
FontBold = -1 'True
FontItalic = -1 'True
FontName = "MS Serif"
FontSize = 24
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00C00000&
Height = 525
Index = 2
Left = -30
TabIndex = 4
Top = 0
Width = 2445
End
Begin Label lblLogo
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "CD Player"
FontBold = -1 'True
FontItalic = -1 'True
FontName = "MS Serif"
FontSize = 24
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00FFFFFF&
Height = 525
Index = 3
Left = 0
TabIndex = 5
Top = 30
Width = 2415
End
End
End
Begin PictureBox minipicLogo
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 210
Left = 3045
ScaleHeight = 210
ScaleWidth = 1095
TabIndex = 10
Top = 60
Width = 1095
Begin Label lblminiLogo
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "CD Player"
FontBold = -1 'True
FontItalic = -1 'True
FontName = "MS Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00C00000&
Height = 195
Index = 0
Left = 120
TabIndex = 11
Top = -15
Width = 900
End
Begin Label lblminiLogo
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "CD Player"
FontBold = -1 'True
FontItalic = -1 'True
FontName = "MS Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00FFFFFF&
Height = 195
Index = 1
Left = 120
TabIndex = 12
Top = 0
Width = 900
End
End
Begin SSPanel DisplayTracks
BackColor = &H00C0C0C0&
BevelInner = 1 'Inset
BevelOuter = 0 'None
Font3D = 0 'None
Height = 855
Left = 105
TabIndex = 18
Top = 225
Width = 6855
Begin SSOption TrackNum
Font3D = 0 'None
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Index = 0
Left = 240
TabIndex = 13
Top = 105
Visible = 0 'False
Width = 200
End
Begin Label TrackLabel
BackStyle = 0 'Transparent
Caption = "1"
Height = 255
Index = 0
Left = 240
TabIndex = 14
Top = 345
Visible = 0 'False
Width = 135
End
End
Begin SSCheck Repeat
Caption = "&Repeat"
Font3D = 0 'None
Height = 255
Left = 6030
TabIndex = 17
Top = 1095
Width = 975
End
Begin PictureBox PicTotalTime
AutoRedraw = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 255
Left = 135
ScaleHeight = 255
ScaleWidth = 3015
TabIndex = 16
Top = 1095
Width = 3015
End
End
Begin SSPanel CDButton3DPanel
BackColor = &H00C0C0C0&
BevelInner = 1 'Inset
Font3D = 0 'None
Height = 855
Left = 45
TabIndex = 6
Top = 1530
Width = 7095
Begin MMControl MMControl1
BackVisible = 0 'False
BorderStyle = 0 'None
DeviceType = "CDAudio"
Height = 615
Left = 150
RecordVisible = 0 'False
StepVisible = 0 'False
TabIndex = 9
Top = 120
Width = 2640
End
Begin SSPanel Status
BackColor = &H00C0C0C0&
BevelInner = 1 'Inset
BevelOuter = 0 'None
Font3D = 0 'None
Height = 495
Left = 3000
TabIndex = 8
Top = 120
Width = 3975
End
Begin SSPanel CDStatusBar
BackColor = &H00C0C0C0&
BevelInner = 1 'Inset
BevelOuter = 0 'None
FloodShowPct = 0 'False
FloodType = 1 'Left To Right
Font3D = 0 'None
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Serif"
FontSize = 6
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 200
Left = 3000
TabIndex = 7
Top = 575
Width = 3975
End
End
Begin PictureBox CDPicture
AutoRedraw = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
DragIcon = CDPLAYER.FRX:0302
DrawMode = 4 'Not Copy Pen
FillStyle = 0 'Solid
ForeColor = &H00000000&
Height = 480
Left = 150
Picture = CDPLAYER.FRX:0604
ScaleHeight = 32
ScaleMode = 3 'Pixel
ScaleWidth = 32
TabIndex = 1
TabStop = 0 'False
Tag = "9130"
Top = 2505
Width = 480
End
Begin TextBox txtFloatTitle
BackColor = &H00E0FFFF&
FontBold = -1 'True
FontItalic = -1 'True
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 285
Left = 1260
TabIndex = 0
Text = "Text1"
Top = 2655
Visible = 0 'False
Width = 735
End
Begin Timer Timer1
Left = 795
Top = 2520
End
Begin Menu mnuExit
Caption = "E&xit"
End
Begin Menu mnuOptions
Caption = "&Options"
Begin Menu mnuOptionsItem
Caption = "&Display Track Time In Icon"
Index = 0
End
Begin Menu mnuOptionsItem
Caption = "-"
Index = 1
End
Begin Menu mnuOptionsItem
Caption = "Alway on &Top"
Index = 2
End
Begin Menu mnuOptionsItem
Caption = "&Floating Titles"
Index = 3
End
End
Begin Menu mnuCDInfo
Caption = "&CD Info"
Begin Menu mnuCDInfoItem
Caption = "A&dd To/Edit CD Database"
Index = 0
End
Begin Menu mnuCDInfoItem
Caption = "About This &CD"
Index = 1
End
Begin Menu mnuCDInfoItem
Caption = "-"
Index = 2
End
Begin Menu mnuCDInfoItem
Caption = "&About CD Player"
Index = 3
End
End
End
Option Explicit
Sub CDStatusBar_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
Call UpdateSeek(CDTime(TrackIndex), X)
End Sub
Sub Form_Load ()
' Initialize some variables to default values
CRLF = Chr$(13) & Chr$(10)
NumOfTracks = 1
AppPath = App.Path
CenterLogo Me, frmDisabledCD
CenterForm CDForm, True
' Check for CD Installed
If MMInstalled() = True Then
InitMMControl
' Check to see if In Play Mode
If CDForm.MMControl1.Mode = 526 Then MMControl1_PlayClick 0
End If
' Get Option Settings
GetOptionSettings
End Sub
Sub Form_Resize ()
If CDForm.WindowState <= 1 And CDForm.mnuOptionsItem(2).Checked = True Then
' Because of the way VB is handling the ICON Window, it destroys
' the old window and creates a new one, thus totally screwing up Alway On Top!
OnTop Me ' Call to turn check off
OnTop Me ' Turn back on new Window
End If
If CDForm.WindowState = 1 And CDForm.mnuOptionsItem(0).Checked = True Then
' Turn on an Icon if not checked
CDForm.Icon = LoadPicture()
Else
CDForm.Icon = CDForm.CDPicture.Picture
End If
End Sub
Sub Form_Unload (Cancel As Integer)
Dim Answer As Integer
If MMControl1.Mode = MCI_MODE_PLAY Then
Answer = MsgBox(CDInfo.CDTitle & " is still playing!" & CRLF & "Are you sure you want to Exit?", 4, "Attention")
If Answer = 6 Then ' Yes
' Save Option Settings
SaveOptionSettings
MMControl1.Command = "Close"
Else ' No
Cancel = True
End If
Else
' Save Option Settings
SaveOptionSettings
MMControl1.Command = "Close"
End If
End Sub
Sub MMControl1_EjectClick (Cancel As Integer)
MMControl1.Command = "Eject"
MMControl1.Command = "Close"
UpdateCaption 0, "None"
CDForm.txtFloatTitle.Visible = False
Timer_Control True
End Sub
Sub MMControl1_PauseClick (Cancel As Integer)
CDForm.Caption = CDInfo.CDTitle & " (Paused)"
End Sub
Sub MMControl1_PlayClick (Cancel As Integer)
Dim I As Integer
MMControl1.UpdateInterval = 1000
MMControl1.From = TrackIndex
If CDForm.Caption = CDInfo.CDTitle & " (Paused)" Then
MMControl1.Command = "Seek"
End If
End Sub
Sub MMControl1_PlayCompleted (ErrorCode As Long)
If ErrorCode = 262 Then
MMControl1.Command = "Close"
Timer_Control True
End If
End Sub
Sub MMControl1_StatusUpdate ()
Static Stopped As Integer
If MMControl1.Mode = MCI_MODE_STOP And CDForm.Caption <> CDInfo.CDTitle & "(Paused)" Then
' Repeat
If Repeat.Value = True And MMControl1.NotifyValue = 1 Then
Call UpdateCaption(1, "Rewinding")
MMControl1.From = "1"
MMControl1.Command = "Play"
Exit Sub
End If
If Stopped = True Then Exit Sub
' Update Form Caption
Call UpdateCaption(CDInfo.CDTrack, "Stopped")
' Update CD Info
Call UpdateCDInfo(0, "00:00")
' Set Icon Timer to 00:00
If CDForm.mnuOptionsItem(0).Checked = True Then
CDForm.Cls
CDForm.Print "00:00"
End If
' Set Stopped Flag
Stopped = True
ElseIf MMControl1.Mode = MCI_MODE_PLAY Then
If CDForm.WindowState = 0 Then
' Clear Form and Reset Flags
CDForm.Cls
Stopped = False
' Get CD Track, Minute and Second Info
CDInfo.CDTrack = GetCDTrack()
' Update Form Caption
Call UpdateCaption(CDInfo.CDTrack, "Play")
' Update CD Info
Call UpdateCDInfo(CInt(CDInfo.CDTrack), GetCDTime())
' Floating Titles
If mnuOptionsItem(3).Checked = True Then FloatingTitle
ElseIf CDForm.WindowState = 1 Then
If mnuOptionsItem(0).Checked = True Then AnimateIcon GetCDTime()
' Update Form Caption
Call UpdateCaption(GetCDTrack(), "Play")
End If
ElseIf MMControl1.Mode = MCI_MODE_READY Then
MMControl1.Command = "Close"
UpdateCaption 0, "None"
CDForm.txtFloatTitle.Visible = False
Timer_Control True
End If
End Sub
Sub MMControl1_StopClick (Cancel As Integer)
' Update Form Caption
Call UpdateCaption(CDInfo.CDTrack, "Stopped")
' Update CD Info
CDForm.Status.Caption = "Length: -None- Time: -None-"
End Sub
Sub mnuCDInfoItem_Click (Index As Integer)
Select Case Index
Case 0 ' Add CD Info
CDEntry.Show 1
Case 1 ' About The CD
CDAbout.Show 1
Case 3 ' About CDPlayer
About.Show 1
End Select
End Sub
Sub mnuExit_Click ()
Unload Me
End Sub
Sub mnuOptionsItem_Click (Index As Integer)
Select Case Index
Case 0 ' Animation
mnuOptionsItem(0).Checked = Not mnuOptionsItem(0).Checked
Case 1 ' Bar
Case 2 ' Always On Top
OnTop Me
Case 3
mnuOptionsItem(Index).Checked = Not mnuOptionsItem(Index).Checked
End Select
End Sub
Sub Timer1_Timer ()
Dim I As Integer
MMControl1.Command = "Open"
If MMControl1.Error = 266 Then
' Control Disabled! No CD Present
CDForm.frmDisabledCD.Caption = "Please Insert A CD!"
frmDisabledCD.Visible = True
ChangeMenuStatus False
If Tracks_Loaded = True Then Call LoadTracks(NumOfTracks, False)
PicTotalTime.Cls
ReDim CDTracks(0)
Else
' Initialize the control
If Tracks_Loaded = True Then Call LoadTracks(NumOfTracks, False)
InitMMControl
ChangeMenuStatus True
CDStatusBar.FloodPercent = 0
Call Timer_Control(False)
End If
End Sub
Sub TrackLabel_Click (Index As Integer)
' Seek to Track
TrackNum(Index).Value = True
TrackPanel3D.Refresh
End Sub
Sub TrackNum_Click (Index As Integer, Value As Integer)
TrackIndex = Index
' Check if just Setting Option
If TrackNumChange = True Then Exit Sub
' Seek to Track
MMControl1.To = TrackIndex
MMControl1.Command = "Seek"
MMControl1.Track = TrackIndex
MMControl1.SetFocus
End Sub
Sub TrackNum_MouseMove (Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Static SavedIndex As Integer
If SavedIndex = Index Then Exit Sub
If mnuOptionsItem(3).Checked = True Then
MouseX = X
MouseY = Y
txtFloatTitle.Visible = False
txtFloatTitle = (Mid$(CDTrackNo(Index), 5, (Len(CDTrackNo(Index)) - 5)))
txtFloatTitle.Width = CDForm.TextWidth(txtFloatTitle) + 100
txtFloatTitle.Height = CDForm.TextHeight(txtFloatTitle)
txtFloatTitle.ZOrder 0
txtFloatTitle.Left = TrackNum(Index).Left
If (txtFloatTitle.Left + txtFloatTitle.Width) > (TrackPanel3D.Left + TrackPanel3D.Width) Then
txtFloatTitle.Left = TrackNum(Index).Left + ((TrackPanel3D.Left + TrackPanel3D.Width) - (txtFloatTitle.Left + txtFloatTitle.Width))
End If
txtFloatTitle.Top = TrackNum(Index).Top
txtFloatTitle.Tag = Index
SavedIndex = Index
txtFloatTitle.Visible = True
End If
End Sub